home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GEVENT.IMP < prev    next >
Text File  |  1992-09-01  |  17KB  |  502 lines
  1.    {*******************************************************************
  2.  
  3.    GEVENT.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.    ZOOM
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    UNZOOM - shrink
  14.  
  15.    ===================================================================}
  16. procedure hdUnZoom ;
  17.    {-------------------------------------------------------------------
  18.    Shrink if full size
  19.    -------------------------------------------------------------------}
  20. procedure Action ( P : PView ) ; FAR ;
  21. begin
  22.    if IsZoomed ( P ) then
  23.       Message ( P , evCommand , cmZoom , NIL ) ;
  24. end ;
  25.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  26.    PROCESS
  27.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  28. begin
  29.    Desktop^.ForEach ( @Action ) ;
  30. end ;
  31.    {===================================================================
  32.  
  33.    ZOOM - expand
  34.  
  35.    ===================================================================}
  36. procedure hdZoom ;
  37.    {-------------------------------------------------------------------
  38.    Expand if not full size
  39.    -------------------------------------------------------------------}
  40. procedure Action ( P : PView ) ; FAR ;
  41. begin
  42.    if not IsZoomed ( P ) then
  43.       Message ( P , evCommand , cmZoom , NIL ) ;
  44. end ;
  45.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  46.    PROCESS
  47.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  48. begin
  49.    Desktop^.ForEach ( @Action ) ;
  50. end ;
  51.    {===================================================================
  52.  
  53.    ALL ZOOMED - return FALSE if any window not zoomed
  54.  
  55.    ===================================================================}
  56. function AllZoomed : boolean ;
  57. var
  58.    w                         : word ;
  59.    {-------------------------------------------------------------------
  60.    Is it full size?
  61.    -------------------------------------------------------------------}
  62. procedure Action ( P : PView ) ; FAR ;
  63. begin
  64.    if not Zoomable ( P ) then EXIT ;
  65.    if not IsZoomed ( P ) then inc ( w ) ;
  66. end ;
  67.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  68.    PROCESS
  69.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  70. begin
  71.    w                         := 0 ;
  72.    Desktop^.ForEach ( @Action ) ;
  73.    AllZoomed                 := w = 0 ;
  74. end ;
  75.    {===================================================================
  76.  
  77.    ZOOM ALL
  78.  
  79.    ===================================================================}
  80. procedure hdZoomAll ;
  81. begin
  82.    if AllZoomed then
  83.       hdUnZoom
  84.    else
  85.       hdZoom ;
  86. end ;
  87.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  88.  
  89.    MISC
  90.  
  91.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  92.    {===================================================================
  93.  
  94.    TILE - VERTICAL (standard)
  95.  
  96.    ===================================================================}
  97. procedure hdTile ;
  98. var
  99.    R                         : TRect ;
  100. begin
  101.    Desktop^.GetExtent ( R ) ;
  102.    Desktop^.Tile ( R ) ;
  103. end ;
  104.    {===================================================================
  105.  
  106.    CASCADE
  107.  
  108.    ===================================================================}
  109. procedure hdCascade ;
  110. var
  111.    R                         : TRect ;
  112. begin
  113.    Desktop^.GetExtent ( R ) ;
  114.    Desktop^.Cascade ( R ) ;
  115. end ;
  116.    {===================================================================
  117.  
  118.    DIRECTORY
  119.  
  120.    ===================================================================}
  121. procedure hdChangeDir ;
  122. begin
  123.    ExecDialog ( New ( PChDirDialog ,
  124.                       Init ( cdNormal , 0 ) ) , NIL ) ;
  125.    hdRefreshDisplay ;
  126. end ;
  127.    {===================================================================
  128.  
  129.    SHOW
  130.  
  131.    ===================================================================}
  132. procedure hdShowClipboard ;
  133. begin
  134.    ClipWindow^.Select ;
  135.    ClipWindow^.Show ;
  136. end ;
  137.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  138.  
  139.    DISPLAY
  140.  
  141.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  142.    {===================================================================
  143.  
  144.    COPY SCREEN - copy from saved buffer to the Clipboard
  145.  
  146.    ===================================================================}
  147. procedure hdCopyScreen ;
  148. var
  149.    y                         : byte ;
  150.    Ch                        : char ;
  151.    S                         : string ;
  152. begin
  153.    ClipWindow^.Hide ;
  154.    VisionOFF ;
  155.    PullScreen ;                                   { From saved buffer }
  156.    with ClipWindow^.Editor^ do
  157.    begin
  158.       SetSelect ( 0 , BufLen , TRUE ) ;                    { all text }
  159.       DeleteSelect ;                                        { dump it }
  160.       for y := 1 to BiosHeight do                               { ROW }
  161.       begin
  162.          S                   := GetLine ( y , SaveScreen ) ;
  163.          S                   := TrimRight ( S , #32 ) ;
  164.          InsertText ( @S[1] , length ( S ) , FALSE ) ;
  165.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  166.    AVOID CR/LF ON LAST LINE
  167.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  168.          if y < BiosHeight then
  169.          begin
  170.             Ch               := #13 ;
  171.             InsertText ( @Ch , 1 , FALSE ) ;                 { add CR }
  172.             Ch               := #10 ;                        { add LF }
  173.             InsertText ( @Ch , 1 , FALSE ) ;
  174.          end ;
  175.       end ;
  176.    end ;
  177.    VisionON ;
  178.    ClipWindow^.Select ;
  179.    ClipWindow^.Show ;
  180.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  181.    Goto top line
  182.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  183.    Message ( ClipWindow , evKeyDown , kbCtrlPgUp , NIL ) ;
  184. end ;
  185.    {===================================================================
  186.  
  187.    REDRAW
  188.  
  189.    ===================================================================}
  190. procedure hdRefreshDisplay ;
  191. begin
  192.    DoneMemory ;                                  { Dump cache buffers }
  193.    Application^.Redraw ;                              { Redisplay all }
  194. end ;
  195.    {===================================================================
  196.  
  197.    USER SCREEN
  198.  
  199.    ===================================================================}
  200. procedure hdUserScreen ;
  201.    {-------------------------------------------------------------------
  202.    -------------------------------------------------------------------}
  203. procedure Hide ( P : PView ) ; FAR ;
  204. begin
  205.    P^.Hide ;
  206. end ;
  207.    {-------------------------------------------------------------------
  208.    -------------------------------------------------------------------}
  209. procedure Show ( P : PView ) ; FAR ;
  210. begin
  211.    P^.Show ;
  212. end ;
  213.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  214.    PROCESS
  215.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  216. var
  217.    Event                     : TEvent ;
  218. begin
  219.    if SaveScreen = NIL then EXIT ;
  220.    HideMouse ;
  221.    Application^.ForEach ( @Hide ) ;
  222.    Application^.Hide ;
  223.    Message ( Application ,
  224.              evBroadcast ,
  225.              cmCommandSetChanged ,
  226.              NIL ) ;
  227.    VisionOFF ;
  228.    InitEvents ;
  229.    PullScreen ;                                   { From saved buffer }
  230.    Application^.ClearEvent ( Event ) ;
  231.    while Event.What = evNothing do
  232.    begin
  233.       Application^.GetEvent ( Event ) ;
  234.       case Event.What of
  235.       evCommand : ;
  236.       evBroadCast : ;
  237.       evKeyDown : ;
  238.       evMouseDown : ;
  239.       else
  240.          Application^.ClearEvent ( Event ) ;
  241.       end ;
  242.    end ;
  243.    DoneEvents ;
  244.    VisionON ;
  245.    Application^.ClearEvent ( Event ) ;
  246.    Application^.ForEach ( @Show ) ;
  247.    Application^.Show ;
  248.    ShowMouse ;
  249.    hdRefreshDisplay ;                                 { redraw screen }
  250.    Message ( Application ,
  251.              evBroadcas